{- This file is part of funbot.
 -
 - Written in 2015, 2016, 2017 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Settings.Sections
    ( migrateFromJSON
    , initTree
    )
where

import Control.Applicative (liftA3)
import Control.Arrow ((&&&), (***))
import Data.Foldable (for_)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Sequence (Seq, (|>), (><), ViewL (..))
import Data.Settings.Section
import Data.Settings.Types
import Database.Persist

import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q
import qualified Data.Text as T

import Data.List.Local (groupByFst)

import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Types.Base (Channel (..))

import FunBot.Model
import FunBot.Settings.MkOption
import FunBot.Settings.Persist
import FunBot.Settings.Sections.Channels
import FunBot.Settings.Sections.DevHosts
import FunBot.Settings.Sections.Feeds
import FunBot.Settings.Sections.Locations
import FunBot.Settings.Sections.Repos
import FunBot.Settings.Sections.Shortcuts
import FunBot.Types
import FunBot.Util

-- | Read stuff from JSONs that should move to the DB, commit it to the DB and
-- clear it from the JSON.
migrateFromJSON :: BotSession ()
migrateFromJSON = do
    cuts <- M.toList . stShortcuts <$> getSettings
    runDB $ for_ cuts $ \ (l, ShortcutDeprecated p b a cs) -> do
        sid <- insert $ Shortcut l p b a
        insertMany_ $ map (ShortcutChannel sid) cs
    modifySettings $ \ s -> s { stShortcuts = M.empty }
    saveBotSettings

-- | Build initial settings tree, already inside the session
initTree :: BotSession ()
initTree = do
    cinfo <- getChanInfo
    sets <- getSettings
    (glocs, locs, cuts) <- runDB $ liftA3 (,,)
        (map (globalLocationLabel . entityVal) <$> selectList [] [])
        (map ((localLocationChannel &&& localLocationLabel) . entityVal) <$>
            selectList [] [Asc LocalLocationChannel]
        )
        (map (shortcutLabel . entityVal &&& entityKey) <$> selectList [] [])
    let locs' = M.fromList $ groupByFst locs
        defs = M.map (const []) cinfo
        locs'' = (locs' `M.intersection` defs) `M.union` defs
        mapKey f g = M.fromList . map (\ k -> (f k, g k)) . M.keys
        mapBoth f g = M.fromList . map (\ (k, v) -> (f k, g k v)) . M.toList
        map' f = M.fromList . map f . M.keys
        tree = Section
            { secOpts = M.empty
            , secSubs = M.fromList
                [ ( "channels"
                  , Section
                        { secOpts = M.empty
                        , secSubs = mapBoth unChannel chanSec locs''
                        }
                  )
                , ( "repos"
                  , Section
                        { secOpts = M.empty
                        , secSubs =
                            mapBoth unDevHostLabel hostSection $
                            stGitAnnChans sets
                        }
                  )
                , ( "feeds"
                  , Section
                        { secOpts = M.empty
                        , secSubs =
                            mapKey (CI.original . unFeedLabel) feedSec $
                            stWatchedFeeds sets
                        }
                  )
                , ( "shortcuts"
                  , Section
                        { secOpts = M.empty
                        , secSubs = M.fromList $ map
                            (CI.foldedCase . unShortcutLabel *** shortcutSec)
                            cuts
                        }
                  )
                , ( "dev-hosts"
                  , Section
                        { secOpts = map' devHostOption $ stDevHosts sets
                        , secSubs = M.empty
                        }
                  )
                , ( "locations"
                  , Section
                        { secOpts = M.fromList $ map locationOption glocs
                        , secSubs = M.empty
                        }
                  )
                ]
            }
    modifyState $ \ s -> s { bsSTree = tree }
